home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / icom_cat / program4.bas < prev    next >
BASIC Source File  |  1993-08-04  |  9KB  |  332 lines
  1. '
  2. ' Program 1 (PARAMETER READING)
  3. '
  4. ' Program taken from the "CT-17 Communication Interface-V (CI-V) Level
  5. ' Converter Instruction Manual". Program converted to IBM QBASIC by Bill
  6. ' Heaton, N7WRI.
  7. '
  8. DEFINT G-Z
  9.  
  10. DECLARE SUB DoCommand (Cmd AS INTEGER, Arg AS STRING)
  11.  
  12. DECLARE SUB GetEcho (Echo AS STRING)
  13. DECLARE SUB GetReply ()
  14. DECLARE SUB GetRig (rig AS STRING)
  15. DECLARE SUB GetTranceive (Tranceive AS STRING)
  16.  
  17. DECLARE SUB SetupBCD ()
  18. DECLARE SUB SetupCOM ()
  19.  
  20. DECLARE SUB ShowLimit (Args AS STRING)
  21. DECLARE SUB ShowFreq (Args AS STRING)
  22. DECLARE SUB ShowMainPrompts ()
  23. DECLARE SUB ShowMode (Args AS STRING)
  24. DECLARE SUB ShowOffset (Args AS STRING)
  25.  
  26. DECLARE FUNCTION BCDtoINT& (BcdString AS STRING, Numbytes AS INTEGER)
  27. DECLARE FUNCTION GetChan$ ()
  28. DECLARE FUNCTION STRTOHEX$ (Str AS STRING)
  29.  
  30. DIM SHARED BCD$(100)
  31.  
  32. '
  33. ' Configuration Information
  34. '
  35.  
  36. CONST RA = &H3C                 ' Receive Address (IC-737)
  37. CONST TA = &HE0                 ' Transmit Address (Computer)
  38. CONST FREQCNT = 5               ' Number of bytes in frequency (IC-737 uses 5)
  39.  
  40. CONST PORT$ = "COM1"            ' Serial Port to use
  41. CONST PORTNO = 1                ' Serial Port to use
  42. CONST CONF$ = "1200,N,8,1"      ' Baud rate, Parity, Bits, Stop Bits
  43.  
  44. CONST SHOWCOM = 1               ' Show Com Packets ( 0=No, 1=Yes)
  45.  
  46. '
  47. ' Initialize
  48. '
  49. SetupCOM
  50. ShowMainPrompts
  51. ShowFreq (CHR$(&H54) + CHR$(&H76) + CHR$(&H98) + CHR$(&H28) + CHR$(&H12))
  52. ShowMode (CHR$(6) + CHR$(2))
  53. ShowOffset (CHR$(&H56) + CHR$(&H34) + CHR$(&H12))
  54.  
  55. a$ = CHR$(&H54) + CHR$(&H76) + CHR$(&H98) + CHR$(&H28) + CHR$(&H12)
  56. b$ = CHR$(&H12) + CHR$(&H23) + CHR$(&H45) + CHR$(&H67) + CHR$(&H15)
  57. ShowLimit (a$ + CHR$(&H2D) + b$)
  58. '
  59. '  Endless loop until an event handler kills us
  60. '
  61. DO UNTIL TRUE
  62. LOOP
  63.  
  64. '
  65. ' Event Handlers
  66. '
  67. Serial: GetReply:           RETURN
  68. F1: DoCommand &H2, "":      RETURN
  69. F2: DoCommand &H3, "":      RETURN
  70. F3: DoCommand &H4, "":      RETURN
  71. F4: DoCommand &HC, "":      RETURN
  72. F0: CLOSE : SYSTEM
  73.  
  74. '
  75. ' BCDtoINT&  Convert BCD to an Integer.
  76. '
  77. '
  78. FUNCTION BCDtoINT& (BcdString AS STRING, Numbytes AS INTEGER)
  79.  
  80.   DA$ = ""
  81.  
  82.   FOR i% = 1 TO Numbytes
  83.     DA$ = RIGHT$("00" + HEX$(ASC(MID$(BcdString, i%, 1))), 2) + DA$
  84.   NEXT i%
  85.  
  86.   BCDtoINT& = VAL(DA$)
  87. END FUNCTION
  88.  
  89. ' +---------------------------------------------------------------------+
  90. ' |                                                                     |
  91. ' |                      ICOM CI-V Packet Layout                        |
  92. ' |     +----------+----------+---------+---------+---------+------+    |
  93. ' |     | Preamble | Transmit | Receive | Command | Sub     | EOM  |    |
  94. ' |     | <FE><FE> | Address  | Address |         | Command | <FD> |    |
  95. ' |     +----------+----------+---------+---------+---------+------+    |
  96. ' |                                                                     |
  97. ' |     A packet consists of two bytes of &HFE, one byte for the        |
  98. ' |     transmit address (Controller), One byte receive address         |
  99. ' |     (Rig), one byte command, one to five byte subcommand, and       |
  100. ' |     finally the tail of one byte of &HFD.                           |
  101. ' |                                                                     |
  102. ' +---------------------------------------------------------------------+
  103. SUB DoCommand (Cmd AS INTEGER, SubCmd AS STRING)
  104.  
  105.   '
  106.   ' Create the packet and send it out
  107.   '
  108.   Out$ = CHR$(&HFE) + CHR$(&HFE) + CHR$(RA) + CHR$(TA) + CHR$(Cmd) + SubCmd + CHR$(&HFD)
  109.   PRINT #1, Out$;
  110.  
  111.   '
  112.   ' If we're watching packets, send to the screen in hex
  113.   '
  114.   IF SHOWCOM THEN
  115.     LOCATE 16, 1: PRINT "Sent: ": LOCATE 16, 7: PRINT STRTOHEX$(Out$); SPACE$(50);
  116.     LOCATE 17, 1: PRINT "Echo: "; SPACE$(50);
  117.     LOCATE 18, 1: PRINT "Rig:  "; SPACE$(50);
  118.     LOCATE 19, 1: PRINT "Tncv: "; SPACE$(50);
  119.   END IF
  120. END SUB
  121.  
  122. SUB GetEcho (Echo AS STRING)
  123.  
  124.   '
  125.   ' Echo replys to the screen if we were told to
  126.   '
  127.   IF SHOWCOM THEN
  128.       LOCATE 17, 7: PRINT STRTOHEX$(Echo);
  129.   END IF
  130.  
  131. END SUB
  132.  
  133. '
  134. ' GetReply      - Character has arrived from rig, stuff it away until
  135. '                 have an entire packet and display it.
  136. '
  137. SUB GetReply
  138.   STATIC Hold$
  139.  
  140.   '
  141.   ' Accumulate the Reply, if its not end of packet get out early
  142.   '
  143.   Hold$ = Hold$ + INPUT$(LOC(PORTNO), PORTNO)
  144.   IF INSTR(Hold$, CHR$(&HFD)) = 0 THEN
  145.     EXIT SUB
  146.   END IF
  147.  
  148.   SELECT CASE MID$(Hold$, 3, 1)         ' Who was the packet from?
  149.     CASE CHR$(RA): GetEcho (Hold$)      '   - Controller
  150.    
  151.     CASE CHR$(TA): GetRig (Hold$)       '   - Rig
  152.    
  153.     CASE CHR$(0):  GetTranceive (Hold$) '   - Transceive Function
  154.   END SELECT
  155.  
  156.  
  157.   ' Get ready for next reply
  158.   Hold$ = ""
  159. END SUB
  160.  
  161. SUB GetRig (rig AS STRING)
  162.   '
  163.   ' Echo replys to the screen if we were told to
  164.   '
  165.   IF SHOWCOM THEN
  166.       LOCATE 18, 7: PRINT STRTOHEX$(rig);
  167.   END IF
  168.  
  169.  
  170.   SELECT CASE MID$(rig, 5, 1)
  171.        
  172.     CASE CHR$(&HFF): LOCATE 25, 1: PRINT "[BLANK]  ";
  173.     CASE CHR$(&HFB): LOCATE 25, 1: PRINT "[OK]     ";
  174.     CASE CHR$(&HFA): LOCATE 25, 1: PRINT "[ERROR]  ";
  175.    
  176.     CASE CHR$(&H2):  ShowLimit (MID$(rig, 6))
  177.     CASE CHR$(&H3):  ShowFreq (MID$(rig, 6))
  178.     CASE CHR$(&H4):  ShowMode (MID$(rig, 6))
  179.     CASE CHR$(&HC):  ShowOffset (MID$(rig, 6))
  180.  
  181.     CASE ELSE:       LOCATE 25, 1: PRINT "[Unknown]";
  182.  
  183.   END SELECT
  184. END SUB
  185.  
  186. SUB GetTranceive (Tranceive AS STRING)
  187.   '
  188.   ' Echo replys to the screen if we were told to
  189.   '
  190.   IF SHOWCOM THEN
  191.       LOCATE 19, 7: PRINT STRTOHEX$(Tranceive);
  192.   END IF
  193.  
  194.   LOCATE 25, 1: PRINT "[Track]  ";
  195.  
  196.   SELECT CASE MID$(Tranceive, 5, 1)
  197.       
  198.     CASE CHR$(&H0):  ShowFreq (MID$(Tranceive, 6))
  199.     CASE CHR$(&H1):  ShowMode (MID$(Tranceive, 6))
  200.  
  201.     CASE ELSE:       LOCATE 25, 1: PRINT "[UnTrack]";
  202.   END SELECT
  203. END SUB
  204.  
  205. '
  206. '  Setup the channel to the serial port
  207. '
  208. SUB SetupCOM
  209.  
  210.   OPEN PORT$ + ":" + CONF$ + ",CD0,CS0,DS0,OP0,RS" FOR RANDOM AS #1
  211.   ON COM(PORTNO) GOSUB Serial
  212.   COM(PORTNO) ON
  213. END SUB
  214.  
  215. DEFDBL F
  216. SUB ShowFreq (Args AS STRING)
  217.  
  218.   LOCATE 8, 2
  219.   PRINT USING "#,###,###,###"; BCDtoINT(Args, FREQCNT)
  220.  
  221. END SUB
  222.  
  223. DEFSNG F
  224. SUB ShowLimit (Args AS STRING)
  225.  
  226.   LOCATE 8, 50
  227.   PRINT USING "#,###,###,###"; BCDtoINT(Args, FREQCNT)
  228.  
  229.   a$ = MID$(Args, FREQCNT + 2)
  230.   LOCATE 8, 65
  231.   PRINT USING "#,###,###,###"; BCDtoINT(a$, FREQCNT)
  232.  
  233. END SUB
  234.  
  235. SUB ShowMainPrompts
  236.                                                   
  237.   CLS
  238.  
  239.   '
  240.   ' Paint the Output Fields
  241.   '
  242.  
  243.   T1$ = "                                                ┌────────── Limits ───────────┐"
  244.   T2$ = "   Frequency       Mode     IF Width    Offset       Lower           Upper     "
  245.   T3$ = "┌──────────────┬─────────┐ ┌────────┐ ┌───────┐ ┌──────────────┬──────────────┐"
  246.   T4$ = "│              │         │ │        │ │       │ │              │              │"
  247.   T5$ = "└──────────────┴─────────┘ └────────┘ └───────┘ └──────────────┴──────────────┘"
  248.  
  249.   LOCATE 5, 1: PRINT T1$;
  250.   LOCATE 6, 1: PRINT T2$;
  251.   LOCATE 7, 1: PRINT T3$;
  252.   LOCATE 8, 1: PRINT T4$;
  253.   LOCATE 9, 1: PRINT T5$;
  254.  
  255.   '
  256.   ' Paint the prompts
  257.   '
  258.   M1$ = "╔═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦══════╗"
  259.   M2$ = "║  F1   ║  F2   ║  F3   ║  F4   ║       ║       ║       ║       ║       ║ F10  ║"
  260.   M3$ = "║ Limits║ Freq  ║ Mode  ║ Offset║       ║       ║       ║       ║       ║ EXIT ║"
  261.   M4$ = "╚═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩══════╝"
  262.  
  263.   LOCATE 21, 1: PRINT M1$;
  264.   LOCATE 22, 1: PRINT M2$;
  265.   LOCATE 23, 1: PRINT M3$;
  266.   LOCATE 24, 1: PRINT M4$;
  267.   VIEW PRINT 1 TO 20
  268.  
  269.   '
  270.   '  Setup function key handlers for each options
  271.   '
  272.   ON KEY(1) GOSUB F1
  273.   ON KEY(2) GOSUB F2
  274.   ON KEY(3) GOSUB F3
  275.   ON KEY(4) GOSUB F4
  276.   ON KEY(10) GOSUB F0
  277.   '
  278.   '  Turn the key handlers on
  279.   '
  280.   FOR i = 1 TO 4
  281.     KEY(i%) ON
  282.   NEXT i
  283.  
  284.   KEY(10) ON
  285. END SUB
  286.  
  287. SUB ShowMode (Args AS STRING)
  288.  
  289.   LOCATE 8, 17
  290.   SELECT CASE MID$(Args, 1, 1)
  291.     CASE CHR$(0): PRINT "   LSB   ";
  292.     CASE CHR$(1): PRINT "   USB   ";
  293.     CASE CHR$(2): PRINT "   AM    ";
  294.     CASE CHR$(3): PRINT "   CW    ";
  295.     CASE CHR$(4): PRINT "  RTTY   ";
  296.     CASE CHR$(5): PRINT "   FM    ";
  297.     CASE CHR$(6): PRINT " Wide-FM ";
  298.     CASE ELSE: PRINT USING "   ##   "; HEX$(ASC(MID$(Args, 1, 1)))
  299.   END SELECT
  300.  
  301.   LOCATE 8, 29
  302.   SELECT CASE MID$(Args, 2, 1)
  303.     CASE CHR$(0): PRINT "        ";
  304.     CASE CHR$(1): PRINT "  Wide  ";
  305.     CASE CHR$(2): PRINT " Narrow ";
  306.     CASE ELSE: PRINT USING "   ##   "; HEX$(ASC(MID$(Args, 2, 1)))
  307.   END SELECT
  308.   
  309. END SUB
  310.  
  311. SUB ShowOffset (Args AS STRING)
  312.  
  313.   i& = BCDtoINT(Args, 3)
  314.   f = CDBL(i&) / 100000
  315.   LOCATE 8, 40
  316.   PRINT USING "#.#####"; f
  317.  
  318. END SUB
  319.  
  320. ' STRTOHEX$ - Translate all the characters in a string to hex and
  321. '             return the resulting string.
  322. '
  323. FUNCTION STRTOHEX$ (Str AS STRING)
  324. Scn$ = ""
  325. FOR i = 1 TO LEN(Str)
  326.      C$ = HEX$(ASC(MID$(Str, i, 1)))
  327.      Scn$ = Scn$ + C$ + " "
  328.   NEXT i
  329. STRTOHEX$ = Scn$
  330. END FUNCTION
  331.  
  332.